perm filename QUADS.SAI[PUB,TES]2 blob
sn#150110 filedate 1975-03-11 generic text, type T, neo UTF8
00100 BEGOF("QUADS")
00200
00300
00400 COMMENT
00500
00600 Tabs, somescripts, infinity, superimpose, flush left, flush right,
00700 and center. Also the INDENT declaration.
00800
00900 ;
01000
01100
01200 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE QUADS! ;$"#
00200 BEGIN "QUADS!"
00300 TABSORT[1]←TWO(33);
00400 END "QUADS!" ;
00100 PUBLIC RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;$"#
00200 PLK: THIS ENTIRE PROCEDURE REWORKED 6-FEB-75
00300 THE INFORMATION PASSED TO PASS2 FOR ∞ STRINGS AND → AND ← IS
00400 (1) WHERE WE WANT TO BE
00500 (2) WHERE WE ARE
00600 (3) 1 OR 2 ( WE LIED IN THE FIRST CASE IF IT WAS CENTERING)
00700 (4) XLENGTH OF THE ∞ STRING (ONLY IN XCRIBL MODE)
00800 (5) THE ∞ STRING
00900 ;
01000 IF ON THEN
01100 BEGIN "BOUND"
01200 STRING FILLER,SEGMENT,BOUNDS;
01300
01400 SIMPLE PROCEDURE TABCASE(INTEGER RB);
01500 BEGIN "TABCASE"
01600 INTEGER LB;
01700 RB←RB*CHARW;
01800 LB←(IF XCRIBL THEN XLBP ELSE LBP) + LMARG*CHARW - (LBFAKE-OLBFAKE);
01900 BOUNDS ← CVSR(RB) & CVSR(LB) & CVSR(1);
02000 SEGMENT←NULL;
02100 FILLER ← LBF;
02200 APPEND(FONTCHAR & "→") ; APPEND (BOUNDS);
02300 IF XCRIBL THEN APPEND(CVSR(XLENGTH(FILLER)));
02400 APPEND(FILLER & ALTMODE);
02500 APPEND(FONTCHAR & "←");
02600 END "TABCASE";
02700
02800 COMMENT
02900 KIND ≤ 0 ... ∞X (THE ASCII OF X NEGATED)
03000 = 1 ... ←
03100 = 2 ... →
03200 = 3 ... CR OR BREAK
03300 = 4 ... TAB (\ OR ∂) ;
03400 IF KIND=3 OR (KIND=4 AND NULSTR(LBF)) THEN
03500 SPCS←0
03600 ELSE EMIT(NULL);
03700 OKCR(TRUE) ; COMMENT ADDED 4/17/72 ;
03800
03900 COMMENT AN EARLIER BOUND ON THIS LINE MAY HAVE SET LBK←KIND ;
04000 IF LBK < 3 THEN
04100 CASE (LBK MAX 0) OF
04200 BEGIN "BY KIND"
04300 [0] COMMENT ∞ ONLY VALID IF IMMEDIATELY PRECEDING THIS BOUND ;
04400 IF (LBO < OAKS) OR (SPCS>0) THEN
04500 BEGIN "SHOULD NOT HAVE MOVED"
04600 WARN("=","∞ NEEDS A RIGHT BOUND") ;
04700 LBF ← NULL ;
04800 END ;
04900 [1] COMMENT CENTER BETWEEN LEFT BOUND AT POSN=LBP AND THIS TAB TO RBOUND, OR BETWEEN MARGINS ;
05000 BEGIN "CENTER"
05100 INTEGER LB,RB,FAKEL,MINL,LASTPOSN;
05200 FAKEL←FAKE-LBFAKE;
05250 LASTPOSN←(IF XCRIBL THEN XLBP ELSE LBP) + LMARG*CHARW;
05300 MINL←(IF XCRIBL THEN (XPOSN-XLBP) ELSE (POSN-LBP))-FAKEL;
05400 RB ← (IF KIND=4 THEN ((RBOUND+LMARG)*CHARW+LASTPOSN) ELSE ((RMARG+LMARG)*CHARW)) - MINL;
05500 LB ← LASTPOSN - (LBFAKE-OLBFAKE);
05600 BOUNDS←CVSR(RB) & CVSR(LB) & CVSR(2); PLK: MUST DIVIDE BY 2 IN PASS2
05700 TO PREVENT TRUCATION FROM HAPPENING TWICE;
05800 SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
05900 APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
06000 IF XCRIBL THEN APPEND(CVSR(XLENGTH(FILLER)));
06100 APPEND(FILLER & ALTMODE);
06200 APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
06300 POSN ← ((RB DIV CHARW) + FAKEL) DIV 2 + MINL;
06400 XPOSN ← (RB + FAKEL) DIV 2 + MINL;
06500 LBFAKE←LBFAKE + ((FAKEL-1) DIV 2); plk: so that OLBFAKE will be right the next time
06600 in the event of an ∞ string;
06700 END "CENTER" ;
06800 [2] COMMENT → RIGHT FLUSH AGAINST TAB TO RBOUND OR AGAINST RIGHT MARGIN ;
06900 BEGIN "RIGHT FLUSH"
07000 INTEGER RB,LB;
07100 RB ← (IF KIND=4 THEN (RBOUND+LMARG)*CHARW ELSE RMARG*CHARW) -
07200 (IF XCRIBL THEN (XPOSN-XLBP) ELSE (POSN-LBP)) +
07300 (FAKE-LBFAKE);
07400 LB←(IF XCRIBL THEN XLBP ELSE LBP) + LMARG*CHARW - (LBFAKE-OLBFAKE);
07500 BOUNDS←CVSR(RB) & CVSR(LB) & CVSR(1);
07600 SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
07700 APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
07800 IF XCRIBL THEN APPEND(CVSR(XLENGTH(FILLER)));
07900 APPEND(FILLER & ALTMODE);
08000 APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
08100 POSN ← RB DIV CHARW;
08200 XPOSN ← RB;
08300 END "RIGHT FLUSH"
08400 END "BY KIND";
08500 IF KIND=3 AND FULSTR(LBF) THEN TABCASE(RMARG);
08600 IF KIND=4 THEN
08700 BEGIN "TAB"
08800 IF FULSTR(LBF) THEN TABCASE(RBOUND+LMARG)
08900 ELSE APPEND(FONTCHAR&"="&CVSR(CHARW*(RBOUND+LMARG)));
09000 BRKXPOSN←BRKXPOSN+FSHORT; FSHORT←0;
09100 POSN ← RBOUND ; XPOSN ← RBOUND * CHARW ;
09200 END "TAB" ;
09300 IF KIND = 4 AND POSN > MAXIM THEN MAXIM ← NMAXIM+LMARG
09400 ELSE IF FILL THEN MAXIM ← IF KIND LEQ 2 THEN NMAXIM ELSE FMAXIM ;
09500 IF KIND = 3 THEN XLBP ← LBP ← LBO ← LBFAKE ← OLBFAKE ← 0 RKJ: 1-22-74;
09600 ELSE
09700 BEGIN "SETUP FOR NEXT TIME"
09805 COMMENT FINALLY, SET LEFT BOUND FOR A SUBSEQUENT BOUND ;
09900 LBO ← OAKS ; LBP ← POSN ; XLBP ← XPOSN ;
10000 LBK ← KIND ; MIDWORD ← FALSE ;
10025 IF KIND LEQ 0 THEN
10050 BEGIN LBF←LBF&(-KIND); RETURN END; plk: cannot reset the LBxx if we
10075 are only making the ∞ string longer;
10100 OLBFAKE ← LBFAKE ; LBFAKE ← FAKE ;
10300 plk: (leq 0) and 3 have been eliminated by now;
10305 IF KIND=4 THEN OLBF←LBF←NULL
10500 ELSE BEGIN OLBF←LBF; LBF←NULL; END;
10900 END "SETUP FOR NEXT TIME";
11000 END "BOUND" ;
00100 PUBLIC SIMPLE PROCEDURE DINDENT ;$"#
00200 BEGIN
00300 STRING X ;
00400 DBREAK ; PASS ; X ← E(NULL,NULL) ; IF ON AND FULSTR(X) THEN FIRSTIM ← CVD(X) ;
00500 IF ITSCH(<,>) THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
00600 IF ON AND FULSTR(X) THEN RESTIM←CVD(X) ;
00700 IF ITSCH(<,>) THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
00800 IF ON AND FULSTR(X) THEN RIGHTIM←CVD(X) ;
00900 END "DINDENT" ;
00100 PUBLIC SIMPLE PROCEDURE DSUPERIMPOSE ;$"#
00200 BEGIN
00300 INTEGER N ;
00400 DBREAK ; PASS ; N ← CVD(E("0",NULL)) MIN 50 ;IF N<1 THEN N←50 ; IF NOT ON THEN RETURN ;
00500 TWEENLFM ← N-1; SINCELFM ← 0; BREAKM ← 5;
00600 END "DSUPERIMPOSE" ;
00100 PUBLIC SIMPLE PROCEDURE DTABS ;$"#
00200 BEGIN TES 8/26/74 REWROTE FOR ASCEND-CHECK AND "ONLY" OPTION ;
00300 INTEGER NUMB, I, BIG ;
00400 BIG ← 0 ;
00500 FOR I ← 1 THRU TABLIMIT DO
00600 BEGIN
00700 PASS ; NUMB ← CVD(E("-9999", NULL)) MIN 9999 ;
00800 IF ON THEN
00900 IF NUMB LEQ BIG THEN
01000 BEGIN
01100 WARN(NULL, <"TAB STOPS " & CVS(BIG) & "," & CVS(NUMB) & " ARE OUT OF ORDER">) ;
01200 I ← I - 1 ;
01300 END
01400 ELSE TABSORT[I] ← BIG ← NUMB ;
01500 IF NOT ITSCH(<,>) THEN BEGIN I ← I + 1 ; DONE END ;
01600 END ;
01700 IF ON AND I > TABLIMIT THEN WARN(NULL,"Too many Tab Stops") ;
01800 NUMB ← IF ITS(ONLY) THEN IPASS(TWO(34)) TES 8/26/73 FOR BRIAN HARVEY ;
01900 ELSE TWO(33) ;
02000 IF ON THEN TABSORT[I] ← NUMB ;
02100 END "DTABS" ;
00100 PUBLIC SIMPLE PROCEDURE SCRIPT(INTEGER ARROW) ;$"#
00200 BEGIN
00300 INTEGER CHR ;
00400 CHR ← LOP(INPUTSTR) ;
00500 HEIGHT ← HEIGHT + (IF ARROW="↑" THEN 1 ELSE -1) ;
00600 ABOVEX ← ABOVEX MAX HEIGHT ; BELOWX ← BELOWX MIN HEIGHT ;
00700 IF POSN LEQ MAXIM OR XCRIBL THEN BEGIN EMIT(NULL) ; APPEND(FONTCHAR&ARROW) ; END ;
00800 RIPTPOSNS ← RIPTPOSNS LSH 9 LOR (POSN+LMARG) ;
00900 IF LDB(SPCODE(CHR))=LBRACK THEN BEGIN SUPERSUB ← SUPERSUB LSH 9 LOR ARROW ;
01000 AMPPOSN ← AMPPOSN LSH 9 ; COMMENT 3/28/72 ; END
01100 ELSE BEGIN EMIT(CHR) ; UNSCRIPT(ARROW) END ;
01200 END "SCRIPT" ;
00100 PUBLIC RECURSIVE PROCEDURE TABTO(INTEGER POSNO) ;$"#
00200 IF ON THEN
00300 BEGIN TES 8/14/74 SIMPLIFIED AND FIXED A BUG ;
00400 POSNO ← POSNO MAX 1-LMARG ; TES 8/11/74 ;
00500 IF (IF XCRIBL THEN (POSNO*CHARW LEQ XPOSN) ELSE (POSNO LEQ POSN)) THEN
00600 IF FULSTR(LBF) THEN
00700 BEGIN
00800 WARN("=","Already passed tab column " & CVS(POSNO)) ;
00900 RETURN ;
01000 END
01100 ELSE TABI ← 0
01200 ELSE IF POSNO>NMAXIM+LMARG THEN
01300 BEGIN
01400 WARN("BAD TAB",<"Can't TAB past right margin to char "&CVS(POSNO)&
01500 (IF FILL THEN CRLF&"Did you really mean to be in FILL mode?" ELSE NULL)>) ;
01600 RETURN
01700 END ;
01800 RBOUND ← POSNO-1 ;
01900 BOUND(4) ;
02000 END "TABTO" ;
00100 PUBLIC SIMPLE PROCEDURE UNSCRIPT(INTEGER ARROW) ;$"#
00200 BEGIN
00300 INTEGER CHR, PN ; BOOLEAN MORE, WILLRIPT ;
00400 IF ARROW = 0 THEN
00500 BEGIN COMMENT "]" -- find matching "[" ;
00600 ARROW ← SUPERSUB LAND '177 ;
00700 AMPPOSN ← AMPPOSN LSH -9 ; COMMENT 3/28/72 ;
00800 SUPERSUB ← SUPERSUB LSH -9 ;
00900 END ;
01000 IF POSN LEQ MAXIM OR XCRIBL THEN
01100 BEGIN
01200 EMIT(NULL) ;
01300 IF ARROW NEQ "." THEN
01400 BEGIN
01500 APPEND(FONTCHAR & ("↑"+"↓" - ARROW)) ;
01600 HEIGHT ← HEIGHT - (IF ARROW="↑" THEN 1 ELSE -1) ;
01700 END ;
01800 END ;
01900 WILLRIPT ← TRUE ; comment assume that RIPTPOSNS will be updated by SCRIPT if necessary ;
02000 IF LDB(SPCODE(INPUTSTR)) = AMSAND THEN
02100 BEGIN
02200 LOPP(INPUTSTR) ;
02300 MORE ← TRUE ; PN ← RIPTPOSNS LAND '177 - LMARG ; COMMENT 3/28/72: ;
02400 AMPPOSN ← ((AMPPOSN LSH -9) LSH 9) LOR ((AMPPOSN LAND '177) MAX POSN) ;
02500 IF PN<POSN THEN BEGIN APPEND(FONTCHAR&"-"&CVSR(POSN-PN)) ; POSN←PN END ;
02600 IF (CHR ← LDB(SPCODE(INPUTSTR))) = LBRACK THEN
02700 BEGIN
02800 SUPERSUB ← SUPERSUB LSH 9 LOR "." ;
02900 LOPP(INPUTSTR) ; WILLRIPT ← FALSE ; comment not a ript: won't call SCRIPT! ;
03000 END
03100 ELSE IF CHR NEQ UARROW AND CHR NEQ DARROW THEN BEGIN EMIT(LOP(INPUTSTR)) ; MORE ← FALSE END ;
03200 END
03300 ELSE MORE ← FALSE ;
03400 IF NOT MORE THEN BEGIN COMMENT 3/28/72: ;
03500 PN ← (AMPPOSN LAND '177) MAX POSN ; AMPPOSN ← (AMPPOSN LSH -9) LSH 9 ;
03600 IF PN>POSN THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(PN-POSN)) ; POSN←PN END END ;
03700 IF WILLRIPT THEN RIPTPOSNS ← RIPTPOSNS LSH -9 ;
03800 END "UNSCRIPT" ;
00100 FINISHED
00200
00300 ENDOF("QUADS")